home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1995 August / 64er_Magazin_95-08_1995_Markt__Technik_de_Side_B.d64 / reldat 3.0 (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  8KB  |  280 lines
  1. 100 rem *************************
  2. 110 rem * demoprogramm fuer     *
  3. 120 rem * relative dateiver-    *
  4. 130 rem * verwaltung            *
  5. 140 rem * 1995 by 64'er magazin *
  6. 150 rem *************************
  7. 597 rem *************************
  8. 598 rem *  programm-handler     *
  9. 599 rem *************************
  10. 600 ga=8: rem floppy-geraeteadresse
  11. 605 mp=1: rem flag fuer menuepunktewahl
  12. 606 gosub800: rem dimensionierung
  13. 610 poke53280,1:poke53281,1:poke646,0:printchr$(14)chr$(8)chr$(147)
  14. 612 for i=1 to 6
  15. 613 read me$(i)
  16. 614 next i
  17. 615 gosub9900
  18. 620 printchr$(19)chr$(13)chr$(13)tab(10)chr$(18)" [210][197][204][193][212][201][214][197] [193][196][210][197][211][211][196][193][212][197][201] "chr$(13)
  19. 629 for c=1 to 6
  20. 630 ifmp=c then printtab(10)chr$(18)me$(mp)
  21. 635 ifmp<>c then printtab(10)me$(c)
  22. 640 next c
  23. 680 get t$
  24. 682 ift$=chr$(17)then mp=mp+1:ifmp>6thenmp=1
  25. 684 ift$=chr$(145)then mp=mp-1:ifmp<1thenmp=1
  26. 686 ift$=chr$(13)then 780
  27. 690 goto620
  28. 780 on mp gosub 1100,9000,7000,8000,2500,2400
  29. 790 goto 620
  30. 797 rem ****************************
  31. 798 rem * variablen dimensionieren *
  32. 799 rem ****************************
  33. 800 dm=400: rem vorgesehene datensatzanzahl
  34. 810 dim id$(dm): rem schluesselwort (indexfeld)
  35. 820 dim in(dm): rem dazugehoerige recordnummer
  36. 830 dim ds$(6): rem datenfelder - bei bedarf erhoehen oder reduzieren!
  37. 840 return
  38. 987 rem ****************************
  39. 988 rem * rel.datei anlegen/oeffnen*
  40. 989 rem ****************************
  41. 990 rem lf=log.filenummer
  42. 991 rem sa=sekundaeradresse
  43. 992 rem dn$=dateiname
  44. 993 rem rl=recordlaenge
  45. 1000 open15,8,15: rem floppy-kommandokanal oeffnen
  46. 1010 open lf,ga,sa,dn$+",l,"+chr$(rl): rem rel-datei oeffnen
  47. 1020 return
  48. 1097 rem ************************
  49. 1098 rem * datei initialisieren *
  50. 1099 rem ************************
  51. 1100 lf=1:sa=2:dn$="adressen":rl=151:gosub1000: rem rel-datei adressen oeffnen
  52. 1110 open2,8,3,"index,s,r": rem seq-datei index zum lesen oeffnen
  53. 1120 gosub4000: rem fehlerkanal lesen
  54. 1130 if er<>0 then ad=0:goto1190: rem datei noch nicht angelegt
  55. 1135 input#2,ad: rem anzahl der datensaetze
  56. 1140 for i=1 to ad
  57. 1142 input#2,id$(i),in(i)
  58. 1144 next i: rem indexdatei lesen
  59. 1190 fl=1: rem kennzeichen 'datei im rechner'
  60. 1192 close 2: rem seq. indexdatei schliessen
  61. 1195 printchr$(13)chr$(13)tab(9)"waehlen mit <[195][210][211][210] auf/ab>"
  62. 1196 printtab(10)"aktivieren mit <[210][197][212][213][210][206]>"
  63. 1199 return
  64. 1987 rem ****************************
  65. 1988 rem * auf record positionieren *
  66. 1989 rem ****************************
  67. 1990 rem sa = sekundaeradresse
  68. 1991 rem rn = record-nummer
  69. 1992 rem rp = position in record
  70. 2000 hb=int(rn/256): lb=rn-256*hb: rem record-nr. in high/low-byte teilen
  71. 2010 print#15,"p"+chr$(sa)+chr$(lb)+chr$(hb)+chr$(rp)
  72. 2020 return
  73. 2397 rem ************************
  74. 2398 rem *    programm beenden  *
  75. 2399 rem ************************
  76. 2400 close1:close15:open4,8,15,"i":close4:printchr$(147):end
  77. 2497 rem ************************
  78. 2498 rem *  dateiarbeit beenden *
  79. 2499 rem ************************
  80. 2500 if fl=0 then gosub9500: return
  81. 2509 print#15,"s:index": rem alte indexdatei loeschen
  82. 2510 open2,8,3,"index,s,w": rem aktualisierte indexdatei zum schreiben oeffnen
  83. 2520 print#2,ad: rem anzahl der records
  84. 2530 for c=1 to ad
  85. 2540 print#2,id$(c)","in(c)
  86. 2550 next c: rem indexdatei sichern
  87. 2560 gosub 3000
  88. 2570 printchr$(147):end
  89. 2996 rem ************************
  90. 2997 rem * rel-datei schliessen *
  91. 2998 rem ************************
  92. 2999 rem lf=log. filenummer
  93. 3000 close lf: rem rel-datei schliessen
  94. 3010 close 15: rem floppy-kanal schl.
  95. 3020 return
  96. 3997 rem **********************
  97. 3998 rem * floppy-fehlerkanal *
  98. 3999 rem **********************
  99. 4000 input#15,er,er$,tr,sk
  100. 4010 rem print er;er$;tr;sk:ohne 'rem' erscheint fehlermeldung auf dem screen!
  101. 4020 return
  102. 4996 rem **********************
  103. 4997 rem * feldl. korrigieren *
  104. 4998 rem **********************
  105. 4999 rem beispiel fuer sechs datenfelder ds$(1)-ds$(6)
  106. 5000 le$="                         ": rem leerstring zum auffuellen
  107. 5010 ds$(1)=left$(ds$(1)+left$(le$,abs(25-len(ds$(1)))),25): rem nachname
  108. 5020 ds$(2)=left$(ds$(2)+left$(le$,abs(25-len(ds$(2)))),25): rem vorname
  109. 5030 ds$(3)=left$(ds$(3)+left$(le$,abs(25-len(ds$(3)))),25): rem strasse
  110. 5040 ds$(4)=left$(ds$(4)+left$(le$,abs(25-len(ds$(4)))),25): rem postleitzahl
  111. 5050 ds$(5)=left$(ds$(5)+left$(le$,abs(25-len(ds$(5)))),25): rem wohnort
  112. 5060 ds$(6)=left$(ds$(6)+left$(le$,abs(25-len(ds$(6)))),25): rem telefon
  113. 5099 return
  114. 5997 rem *************************
  115. 5998 rem * record zusammenfassen *
  116. 5999 rem *************************
  117. 6000 rc$="":rem variable fuer inhalt des gesamt-records
  118. 6010 for c=1 to 6: rem =menge!
  119. 6020 rc$=rc$+ds$(c)
  120. 6030 next c
  121. 6040 return
  122. 6997 rem *************************
  123. 6998 rem *    daten eingeben     *
  124. 6999 rem *************************
  125. 7000 if fl=0 then gosub9500: return
  126. 7009 printchr$(147)left$(la$,79)
  127. 7010 printchr$(19)chr$(18)tab(2)" [196]ateneingabe-[205]aske "tab(23)"[210]ecord-[206]r.: ";ad+1
  128. 7015 print
  129. 7020 printtab(2)"[206]achname: "
  130. 7022 printtab(2)"[214]orname : "
  131. 7024 printtab(2)"[211]trasse : "
  132. 7026 printtab(2)"[208][204][218]     : "
  133. 7028 printtab(2)"[215]ohnort : "
  134. 7030 printtab(2)"[212]elefon : "
  135. 7032 print:printleft$(la$,79)
  136. 7040 sp=12: rem eingabespalte bleibt gleich!
  137. 7045 for zl=2 to 7
  138. 7047 gosub 7900: rem eingabe-cursor positionieren
  139. 7050 poke19,64:inputds$(zl-1):poke19,0:print
  140. 7060 next zl
  141. 7070 rem eingabe in indexdatei vermerken
  142. 7080 ad=ad+1: rn=ad: rem datensatzanzahl inkrementieren
  143. 7090 id$(ad)=ds$(1): rem schluesseldatenfeld
  144. 7100 in(ad)=rn: rem recordnummer
  145. 7110 :
  146. 7120 rem datenfelder mit passender laenge ausstatten
  147. 7130 gosub 5000: rem unterprogramm muss auf sechs datenfelder eingerichtet sein
  148. 7199 :
  149. 7200 rem dateneingabe zur speicherung zusammenfassen
  150. 7210 gosub 6000
  151. 7228 rem ***********************
  152. 7229 rem * datensatz speichern *
  153. 7230 rem ***********************
  154. 7240 rn=ad:rp=1:gosub 2000: rem record positionieren
  155. 7250 print#lf,rc$: rem datensatz schreiben
  156. 7260 gosub 4000: rem fehlerkanal
  157. 7270 printchr$(13)tab(6)chr$(18)" [196]atensatz wurde gesichert!"
  158. 7272 for t=1 to 1500: next t: printchr$(147)
  159. 7280 gosub9900:return
  160. 7888 rem *************************
  161. 7898 rem * cursor-positionierung *
  162. 7899 rem *************************
  163. 7900 poke214,zl:poke 211,sp
  164. 7902 sys 58640
  165. 7904 return
  166. 7997 rem *************************
  167. 7998 rem *   daten ausgeben      *
  168. 7999 rem *************************
  169. 8000 if fl=0 then gosub 9500 :return
  170. 8010 printchr$(147):poke19,64:input"[201]ndex-[194]egr.:";ix$:poke19,0:rem indexabfrage
  171. 8020 for c=1 to ad: rem indexdatei durchsuchen
  172. 8030 if ix$=id$(c) then gn=c:c=ad:next c:goto 8100: rem index gefunden
  173. 8040 next c
  174. 8050 printchr$(147)"[211]chluesselwort falsch oder":print"nicht vorhanden!"
  175. 8052 fort=1 to 1000:next
  176. 8060 printchr$(147):gosub9900:return
  177. 8100 rn=gn:rp=1:rc$="":gosub2000:rem record postionieren
  178. 8110 fori=1 to rl-1
  179. 8111 get#lf,by$:rc$=rc$+by$
  180. 8112 next i
  181. 8119 rem **************************
  182. 8120 rem * gesamtstring aufteilen *
  183. 8121 rem **************************
  184. 8130 ds$(1)=mid$(rc$,1,25): rem nachname
  185. 8132 ds$(2)=mid$(rc$,26,25): rem vorname
  186. 8134 ds$(3)=mid$(rc$,51,25): rem strasse
  187. 8136 ds$(4)=mid$(rc$,76,25): rem plz
  188. 8137 ds$(5)=mid$(rc$,101,25): rem wohnort
  189. 8138 ds$(6)=mid$(rc$,126,25): rem telefon
  190. 8139 rem *****************************
  191. 8140 rem datensatz auf screen ausgeben
  192. 8141 rem *****************************
  193. 8142 printchr$(147)left$(la$,79)
  194. 8143 printchr$(19)chr$(18)tab(2)" [196]atenausgabe "tab(23)"[210]ecord-[206]r.: ";rn
  195. 8150 printchr$(13):for c=1 to 6
  196. 8160 printtab(5)ds$(c)
  197. 8170 next c
  198. 8172 print:printleft$(la$,79)+chr$(145)+chr$(145)
  199. 8180 gosub8300
  200. 8185 printchr$(147):gosub9900:return
  201. 8195 rem **************************
  202. 8196 rem *  druckausgabe          *
  203. 8197 rem **************************
  204. 8200 open4,4,7:cmd1
  205. 8210 print#4,"[210]ecord-[206]r.:";str$(rn)
  206. 8220 for c=1 to 6
  207. 8230 print#4,ds$(c)
  208. 8240 next
  209. 8250 print#4:close4
  210. 8260 return
  211. 8300 print:print" [196]atensatz "chr$(18)"d"chr$(146)"rucken ";
  212. 8305 printchr$(18)"e"chr$(146)"ditieren "chr$(18)"[200]"chr$(146)"auptmenue "
  213. 8310 gett$
  214. 8320 ift$="d"thengosub8200:return
  215. 8330 ift$="e"thengosub8400:return
  216. 8335 ift$="h"thenreturn
  217. 8340 goto8310
  218. 8400 printchr$(147)left$(la$,79)
  219. 8410 printchr$(19)chr$(18)tab(2)" [196]atensatz editieren "tab(23)"[210]ecord-[206]r.: ";rn
  220. 8420 print
  221. 8430 printtab(2)"[206]achname: ";ds$(1)
  222. 8440 printtab(2)"[214]orname : ";ds$(2)
  223. 8450 printtab(2)"[211]trasse : ";ds$(3)
  224. 8460 printtab(2)"[208][204][218]     : ";ds$(4)
  225. 8470 printtab(2)"[215]ohnort : ";ds$(5)
  226. 8480 printtab(2)"[212]elefon : ";ds$(6)
  227. 8490 print:printleft$(la$,79)
  228. 8500 sp=12: rem eingabespalte bleibt gleich!
  229. 8510 for zl=2 to 7
  230. 8520 gosub 7900: rem eingabe-cursor positionieren
  231. 8540 poke19,64:inputds$(zl-1):poke19,0:print
  232. 8550 next zl
  233. 8552 id$(rn)=ds$(1): in(rn)=rn
  234. 8560 gosub 5000: gosub 6000
  235. 8565 rp=1: gosub 2000: gosub 7250
  236. 8570 return
  237. 9000 printchr$(147)
  238. 9010 fori=1toad
  239. 9020 printid$(i)
  240. 9030 next i
  241. 9040 print:printchr$(18)" [212][193][211][212][197] "
  242. 9050 poke198,0:wait198,1
  243. 9060 mp=4:gosub 9900: return
  244. 9497 rem **************************
  245. 9498 rem * keine datei geoeffnet! *
  246. 9499 rem **************************
  247. 9500 printchr$(147):gosub 9900
  248. 9530 printchr$(19)chr$(13)chr$(13)tab(13)" [198][197][200][204][197][210][205][197][204][196][213][206][199] "chr$(13)chr$(13)
  249. 9535 printtab(12)"[196]atei wurde noch"
  250. 9536 printtab(12)"nicht initialisiert"
  251. 9537 printtab(12)"oder angelegt!!!"
  252. 9590 fort=1to1500:next
  253. 9592 printchr$(147):gosub9900
  254. 9599 return
  255. 9897 rem *************************
  256. 9898 rem * unterpr. window       *
  257. 9899 rem *************************
  258. 9900 e1$="[176]":e2$="[174]":e3$="[173]":e4$="[189]"
  259. 9901 ul$="[171]":ur$="[179]":ln$=""
  260. 9904 fori=1to22:ln$=ln$+"[192]":next
  261. 9905 la$=ln$+ln$
  262. 9906 printchr$(19):printtab(9)e1$ln$e2$
  263. 9907 zl=2:sp=9:gosub7900
  264. 9908 for c=1 to 8
  265. 9910 printtab(9)"[221]"tab(32)"[221]"
  266. 9911 next c
  267. 9913 printtab(9)e3$ln$e4$
  268. 9915 zl=3:sp=9:gosub7900
  269. 9916 printtab(9)ul$ln$ur$
  270. 9920 return
  271. 9997 rem *************************
  272. 9998 rem *      menuepunkte      *
  273. 9999 rem *************************
  274. 10000 data" [196]atei initialisieren "
  275. 10005 data" [211]uchbegriff-[204]iste    "
  276. 10010 data" [196]ateneingabe         "
  277. 10020 data" [196]atenausgabe         "
  278. 10030 data" [196]atei schliessen     "
  279. 10040 data" [208]rogramm beenden     "
  280.